Delphi Anthology/aDELPHI.iso/Runimage/Delphi50/Source/Property Editors/adoreg.pas

Pascal/Delphi Source File | 1999-08-11 | 31KB | 1,115 lines

{*******************************************************}
{                                                       }
{       Borland Delphi Visual Component Library         }
{       ADO Component Registration                      }
{                                                       }
{       Copyright (c) 1999 Inprise Corporation          }
{                                                       }
{*******************************************************}

unit ADOReg;

interface

uses
  SysUtils, Classes, Forms, Controls,
  FldLinks, CustomModuleEditors,
  ParentageSupport, DsnDB, ModelViews, ModelPrimitives,
  DataModelViews, DataModelSupport,
  DB, DsgnIntf, DSNDBCST, DBReg, ColnEdit, ADODB;

type

{ Property Editors }

{ TProviderProperty }

  TProviderProperty = class(TDBStringProperty)
  public
    procedure GetValueList(List: TStrings); override;
  end;

{ TConnectionStringProperty }

  TConnectionStringProperty = class(TStringProperty)
  public
    function GetAttributes: TPropertyAttributes; override;
    procedure Edit; override;
  end;

{ TCommandTextProperty }

  TCommandTextProperty = class(TDBStringProperty)
  private
    FCommandType: TCommandType;
    FConnection: TADOConnection;
  public
    procedure Activate; override;
    function AutoFill: Boolean; override;
    procedure Edit; override;
    procedure EditSQLText; virtual;
    function GetAttributes: TPropertyAttributes; override;
    function GetConnection(Opened: Boolean): TADOConnection;
    procedure GetValueList(List: TStrings); override;
    property CommandType: TCommandType read FCommandType write FCommandType;
  end;

{ TTableNameProperty }

  TTableNameProperty = class(TCommandTextProperty)
  public
    procedure Activate; override;
  end;

{ TProcedureNameProperty }

  TProcedureNameProperty = class(TCommandTextProperty)
  public
    procedure Activate; override;
  end;

{ TParametersProperty }

  TParametersProperty = class(TCollectionProperty)
  public
    procedure Edit; override;
  end;

{ TADODataSetFieldLinkProperty }

  TADODataSetFieldLinkProperty = class(TFieldLinkProperty)
  private
    FADODataSet: TADODataSet;
  protected
    function GetIndexFieldNames: string; override;
    function GetMasterFields: string; override;
    procedure SetIndexFieldNames(const Value: string); override;
    procedure SetMasterFields(const Value: string); override;
  public
    procedure Edit; override;
  end;

{ TADOTableFieldLinkProperty }

  TADOTableFieldLinkProperty = class(TFieldLinkProperty)
  private
    FTable: TADOTable;
  protected
    function GetIndexFieldNames: string; override;
    function GetMasterFields: string; override;
    procedure SetIndexFieldNames(const Value: string); override;
    procedure SetMasterFields(const Value: string); override;
  public
    procedure Edit; override;
  end;

{ TADOIndexNameProperty }

  TADOIndexNameProperty = class(TDBStringProperty)
  public
    procedure GetValueList(List: TStrings); override;
  end;

{ Component Editors }

{ TADOConnectionEditor }

  TADOConnectionEditor = class(TComponentEditor)
  public
    procedure ExecuteVerb(Index: Integer); override;
    function GetVerb(Index: Integer): string; override;
    function GetVerbCount: Integer; override;
  end;

{ TADOCommandEditor }

  TADOCommandEditor = class(TComponentEditor)
  public
    procedure ExecuteVerb(Index: Integer); override;
    function GetVerb(Index: Integer): string; override;
    function GetVerbCount: Integer; override;
  end;

{ TADODataSetEditor }

  TADODataSetEditor = class(TDataSetEditor)
  private
    FCanCreate: Boolean;
  public
    procedure ExecuteVerb(Index: Integer); override;
    function GetVerb(Index: Integer): string; override;
    function GetVerbCount: Integer; override;
  end;

{ Data Module Designer Support }

const
  cConnectionSprigPrefix = '<ImpliedConnection>'; { do not localize }

type
  TADOConnectionSprig = class(TSprigAtRoot)
  public
    function AnyProblems: Boolean; override;
    function Caption: string; override;
  end;

  TADOImpliedConnectionSprig = class(TSprigAtRoot)
  private
    FConnectionString: string;
  public
    function AnyProblems: Boolean; override;
    function UniqueName: string; override;
    function Caption: string; override;
    function Transient: Boolean; override;
    function ItemClass: TClass; override;
  end;

  TRDSConnectionSprig = class(TSprigAtRoot)
  end;

  TADOCommandSprig = class(TSprig)
  public
    procedure FigureParent; override;
    function DragDropTo(AItem: TSprig): Boolean; override;
    function DragOverTo(AItem: TSprig): Boolean; override;
    function AnyProblems: Boolean; override;
    class function PaletteOverTo(AParent: TSprig; AClass: TClass): Boolean; override;
    function Caption: string; override;
  end;

  TADOCommandIsland = class(TIsland)
  public
    function VisibleTreeParent: Boolean; override;
  end;

  TCustomADODataSetSprig = class(TDataSetSprig)
  public
    procedure FigureParent; override;
    function AnyProblems: Boolean; override;
    function DragDropTo(AItem: TSprig): Boolean; override;
    function DragOverTo(AItem: TSprig): Boolean; override;
    class function PaletteOverTo(AParent: TSprig; AClass: TClass): Boolean; override;
  end;

  TADODataSetSprig = class(TCustomADODataSetSprig)
  public
    procedure FigureParent; override;
    function AnyProblems: Boolean; override;
    function DragDropTo(AItem: TSprig): Boolean; override;
    function DragOverTo(AItem: TSprig): Boolean; override;
    class function PaletteOverTo(AParent: TSprig; AClass: TClass): Boolean; override;
    function Caption: string; override;
  end;

  TADOTableSprig = class(TCustomADODataSetSprig)
  public
    function AnyProblems: Boolean; override;
    function Caption: string; override;
  end;

  TADOStoredProcSprig = class(TCustomADODataSetSprig)
  public
    function AnyProblems: Boolean; override;
    function Caption: string; override;
  end;

  TADOQuerySprig = class(TCustomADODataSetSprig)
  public
    function AnyProblems: Boolean; override;
  end;

  TCustomADODataSetIsland = class(TIsland)
  public
    function VisibleTreeParent: Boolean; override;
  end;

  TADODataSetIsland = class(TCustomADODataSetIsland)
  end;

  TADOTableIsland = class(TCustomADODataSetIsland)
  end;

  TADOQueryIsland = class(TCustomADODataSetIsland)
  end;

  TCustomADODataSetMasterDetailBridge = class(TMasterDetailBridge)
  public
    class function GetOmegaSource(AItem: TPersistent): TDataSource; override;
    class procedure SetOmegaSource(AItem: TPersistent; ADataSource: TDataSource); override;
    function Caption: string; override;
  end;

  TADODataSetMasterDetailBridge = class(TCustomADODataSetMasterDetailBridge)
  public
    function CanEdit: Boolean; override;
    function Edit: Boolean; override;
    class function OmegaIslandClass: TIslandClass; override;
  end;

  TADOTableMasterDetailBridge = class(TCustomADODataSetMasterDetailBridge)
  public
    function CanEdit: Boolean; override;
    function Edit: Boolean; override;
    class function OmegaIslandClass: TIslandClass; override;
  end;

  TADOQueryMasterDetailBridge = class(TCustomADODataSetMasterDetailBridge)
  public
    class function OmegaIslandClass: TIslandClass; override;
  end;

procedure Register;

implementation

uses TypInfo, ADOConEd, Consts, SQLEdit, Dialogs;

{ Utility functions }

function EditFileName(ADataSet: TADODataSet; LoadData: Boolean): Boolean;
begin
  with TOpenDialog.Create(nil) do
  try
    Title := sOpenFileTitle;
    DefaultExt := 'adtg';
    Filter := SADODataFilter;
    Result := Execute;
    if Result then
      if LoadData then
        ADataSet.LoadFromFile(FileName) else
        ADataSet.CommandText := FileName;
  finally
    Free;
  end;
end;

procedure SaveToFile(ADataSet: TADODataSet);
var
  PersistFormat: TPersistFormat;
begin
  with TSaveDialog.Create(nil) do
  try
    Options := [ofOverwritePrompt];
    DefaultExt := 'adtg';
    Filter := SADODataFilter;
    if Execute then
    begin
      if FilterIndex = 2 then
        PersistFormat := pfXML else
        PersistFormat := pfADTG;
      ADataSet.SaveToFile(FileName, PersistFormat);
    end;
  finally
    Free;
  end;
end;

{ TProviderProperty }

procedure TProviderProperty.GetValueList(List: TStrings);
begin
  GetProviderNames(List);
end;

{ TConnectionStringProperty }

function TConnectionStringProperty.GetAttributes: TPropertyAttributes;
begin
  Result := [paDialog];
end;

procedure TConnectionStringProperty.Edit;
begin
  if EditConnectionString(GetComponent(0) as TComponent) then
    Modified;
end;

{ TCommandTextProperty }

function TCommandTextProperty.GetAttributes: TPropertyAttributes;
begin
  if CommandType in [cmdTable, cmdTableDirect, cmdStoredProc] then
    Result := [paValueList, paSortList, paMultiSelect] else {Drop down list for name list}
    Result := [paMultiSelect, paRevertable, paDialog]; {SQL or File}
end;

procedure TCommandTextProperty.Activate;
var
  PropInfo: PPropInfo;
  Component: TComponent;
begin
  Component := GetComponent(0) as TComponent;
  PropInfo := TypInfo.GetPropInfo(Component.ClassInfo, 'CommandType'); { do not localize }
  if Assigned(PropInfo) then
    CommandType := TCommandType(GetOrdProp(Component, PropInfo)) else
    CommandType := cmdText;
end;

procedure TCommandTextProperty.EditSQLText;
var
  Command: string;
  Connection: TADOConnection;
begin
  if paDialog in GetAttributes then
  begin
    Command := GetStrValue;
    Connection := GetConnection(True);
    try
      if EditSQL(Command, Connection.GetTableNames, Connection.GetFieldNames) then
        SetStrValue(Command);
    finally
      FConnection.Free;
      FConnection := nil;
    end;
  end;
end;

procedure TCommandTextProperty.Edit;
begin
  case CommandType of
    cmdText, cmdUnknown: EditSQLText;
    cmdFile: EditFileName(GetComponent(0) as TADODataSet, False);
  else
    inherited;
  end;
end;

function TCommandTextProperty.GetConnection(Opened: Boolean): TADOConnection;
var
  Component: TComponent;
  ConnectionString: string;
begin
  Component := GetComponent(0) as TComponent;
  Result := TObject(GetOrdProp(Component, TypInfo.GetPropInfo(Component.ClassInfo,
    'Connection'))) as TADOConnection; { do not localize }
  if not Opened then Exit;
  if not Assigned(Result) then
  begin
    ConnectionString := TypInfo.GetStrProp(Component,
      TypInfo.GetPropInfo(Component.ClassInfo, 'ConnectionString')); { do not localize }
    if ConnectionString = '' then Exit;
    FConnection := TADOConnection.Create(nil);
    FConnection.ConnectionString := ConnectionString;
    FConnection.LoginPrompt := False;
    Result := FConnection;
  end;
  Result.Open;
end;

procedure TCommandTextProperty.GetValueList(List: TStrings);
var
  Connection: TADOConnection;
begin
  Connection := GetConnection(True);
  if Assigned(Connection) then
  try
    case CommandType of
      cmdTable, cmdTableDirect:
        Connection.GetTableNames(List);
      cmdStoredProc:
        Connection.GetProcedureNames(List);
    end;
  finally
    FConnection.Free;
    FConnection := nil;
  end;
end;

function TCommandTextProperty.AutoFill: Boolean;
var
  Connection: TADOConnection;
begin
  Connection := GetConnection(False);
  Result := Assigned(Connection) and Connection.Connected;
end;

{ TTableNameProperty }

procedure TTableNameProperty.Activate;
begin
  CommandType := cmdTable;
end;

{ TProcedureNameProperty }

procedure TProcedureNameProperty.Activate;
begin
  CommandType := cmdStoredProc;
end;


{ TParametersProperty }

procedure TParametersProperty.Edit;
var
  Parameters: TParameters;
begin
  try
    Parameters := TParameters(GetOrdValue);
    if Parameters.Count = 0 then Parameters.Refresh;
  except
    { Ignore any error when trying to refresh the params }
  end;
  inherited Edit;
end;

{ TADODataSetFieldLinkProperty }

procedure TADODataSetFieldLinkProperty.Edit;
begin
  FADODataSet := DataSet as TADODataSet;
  inherited Edit;
end;

function TADODataSetFieldLinkProperty.GetIndexFieldNames: string;
begin
  Result := FADODataSet.IndexFieldNames;
end;

function TADODataSetFieldLinkProperty.GetMasterFields: string;
begin
  Result := FADODataSet.MasterFields;
end;

procedure TADODataSetFieldLinkProperty.SetIndexFieldNames(const Value: string);
begin
  FADODataSet.IndexFieldNames := Value;
end;

procedure TADODataSetFieldLinkProperty.SetMasterFields(const Value: string);
begin
  FADODataSet.MasterFields := Value;
end;

{ TADOTableFieldLinkProperty }

procedure TADOTableFieldLinkProperty.Edit;
begin
  FTable := DataSet as TADOTable;
  inherited Edit;
end;

function TADOTableFieldLinkProperty.GetIndexFieldNames: string;
begin
  Result := FTable.IndexFieldNames;
end;

function TADOTableFieldLinkProperty.GetMasterFields: string;
begin
  Result := FTable.MasterFields;
end;

procedure TADOTableFieldLinkProperty.SetIndexFieldNames(const Value: string);
begin
  FTable.IndexFieldNames := Value;
end;

procedure TADOTableFieldLinkProperty.SetMasterFields(const Value: string);
begin
  FTable.MasterFields := Value;
end;

{ TADOIndexNameProperty }

procedure TADOIndexNameProperty.GetValueList(List: TStrings);
var
  IndexDefs: TIndexDefs;
begin
  if GetComponent(0) is TADODataSet then
    IndexDefs := TADODataSet(GetComponent(0)).IndexDefs
  else
    IndexDefs := TADOTable(GetComponent(0)).IndexDefs;
  IndexDefs.Updated := False;
  IndexDefs.Update;
  IndexDefs.GetItemNames(List);
end;

{ TADOConnectionEditor }

procedure TADOConnectionEditor.ExecuteVerb(Index: Integer);
var
  I: Integer;
begin
  I := inherited GetVerbCount;
  if Index < I then inherited else
  begin
    case Index - I of
      0: if EditConnectionString(Component) then Designer.Modified;
    end;
  end;
end;

function TADOConnectionEditor.GetVerb(Index: Integer): string;
var
  I: Integer;
begin
  I := inherited GetVerbCount;
  if Index < I then Result := inherited GetVerb(Index) else
    case Index - I of
      0: Result := SADOConnectionEditor;
    end;
end;

function TADOConnectionEditor.GetVerbCount: Integer;
begin
  Result := inherited GetVerbCount + 1;
end;


{ TADOCommandEditor }

procedure TADOCommandEditor.ExecuteVerb(Index: Integer);
var
  I: Integer;
begin
  I := inherited GetVerbCount;
  if Index < I then inherited else
  begin
    case Index - I of
      0: TADOCommand(Component).Execute;
    end;
  end;
end;

function TADOCommandEditor.GetVerb(Index: Integer): string;
var
  I: Integer;
begin
  I := inherited GetVerbCount;
  if Index < I then Result := inherited GetVerb(Index) else
    case Index - I of
      0: Result := SCommandExecute;
    end;
end;

function TADOCommandEditor.GetVerbCount: Integer;
begin
  Result := inherited GetVerbCount;
  if TADOCommand(Component).CommandText <> '' then
     Inc(Result);
end;

{ TADODataSetEditor }

procedure TADODataSetEditor.ExecuteVerb(Index: Integer);
begin
  if Index <= inherited GetVerbCount - 1 then
    inherited ExecuteVerb(Index) else
  begin
    Dec(Index, inherited GetVerbCount);
    if (Index > 0) and not FCanCreate then Inc(Index);
    case Index of
      0: begin
           EditFileName(Component as TADODataSet, True);
           Designer.Modified;
         end;
      1: begin
           TADODataSet(Component).CreateDataSet;
           Designer.Modified;
         end;
      2: SaveToFile(Component as TADODataSet);
    end;
  end;
end;

function TADODataSetEditor.GetVerb(Index: Integer): string;
begin
  if Index <= inherited GetVerbCount - 1 then
    Result := inherited GetVerb(Index) else
  begin
    Dec(Index, inherited GetVerbCount);
    if (Index > 0) and not FCanCreate then Inc(Index);
    case Index of
      0: Result := SLoadFromFile;
      1: Result := SCreateDataSet;
      2: Result := SSaveToFile;
    end;
  end;
end;

function TADODataSetEditor.GetVerbCount: Integer;
begin
  Result := inherited GetVerbCount + 1; { LoadFromFile }
  with TADODataSet(Component) do
  begin
    FCanCreate := not Active and ((FieldCount > 0) or (FieldDefs.Count > 0));
    { either CreateDataSet or SaveToFile (but never both) }
    if FCanCreate or Active then Inc(Result);
  end;
end;


{ Data Module Designer Support }

const
  cCommandTypes: array [TCommandType] of string = ('Unknown', 'Text', 'Table', { Do not localize }
                                                   'StoredProc', 'File', { Do not localize }
                                                   'TableDirect'); { Do not localize }

function SprigADOImpliedConnectionName(const AName: string): string;
begin
  Result := Format('%s.%s', [cConnectionSprigPrefix, AName]); { do not localize }
end;

{ TADOConnectionSprig }

function TADOConnectionSprig.AnyProblems: Boolean;
begin
  Result := TADOConnection(Item).ConnectionString = '';
end;

function TADOConnectionSprig.Caption: string;
begin
  Result := CaptionFor(TADOConnection(Item).Provider, UniqueName);
end;

{ TADOImpliedConnectionSprig }

function TADOImpliedConnectionSprig.AnyProblems: Boolean;
begin
  Result := FConnectionString = '';
end;

function TADOImpliedConnectionSprig.Caption: string;
begin
  Result := CaptionFor(FConnectionString, 'Implied ADO Connection'); { Do not localize }
end;

function TADOImpliedConnectionSprig.UniqueName: string;
begin
  Result := SprigADOImpliedConnectionName(FConnectionString);
end;

function TADOImpliedConnectionSprig.Transient: Boolean;
begin
  Result := True;
end;

function TADOImpliedConnectionSprig.ItemClass: TClass;
begin
  Result := TADOConnection;
end;

{ ADO connection/connectionstring support }

function ADOConAnyProblems(AConnection: TADOConnection; const AConnectionString: WideString): Boolean;
begin
  Result := (AConnection = nil) and
            (AConnectionString = '');
end;

function ADOConDropOver(AParent: TSprig; var AConnection: TADOConnection; var AConnectionString: WideString): Boolean;
begin
  Result := False;
  if AParent is TADOConnectionSprig then
  begin
    Result := TADOConnection(AParent.Item) <> AConnection;
    if Result then
      AConnection := TADOConnection(AParent.Item);
  end
  else if AParent is TADOImpliedConnectionSprig then
  begin
    Result := AConnectionString <> TADOImpliedConnectionSprig(AParent).FConnectionString;
    if Result then
      AConnectionString := TADOImpliedConnectionSprig(AParent).FConnectionString;
  end;
end;

function ADOConDragOver(AItem: TSprig): Boolean;
begin
  Result := (AItem is TADOConnectionSprig) or
            (AItem is TADOImpliedConnectionSprig);
end;

function ADOConFigureParent(ASprig: TSprig; AConnection: TADOConnection; const AConnectionString: WideString): Boolean;
var
  vConnection: TSprig;
begin
  // assume failure
  vConnection := nil;

  // if connection is not nil then look for it
  if AConnection <> nil then
    vConnection := ASprig.Root.Find(AConnection, False);

  // else if connection string is not nil then look for it
  if vConnection = nil then
  begin
    vConnection := ASprig.Root.Find(SprigADOImpliedConnectionName(AConnectionString), False);

    // if connection string cannot be found then make one
    if vConnection = nil then
    begin
      vConnection := ASprig.Root.Add(TADOImpliedConnectionSprig.Create(nil));
      TADOImpliedConnectionSprig(vConnection).FConnectionString := AConnectionString;
    end;
  end;

  // use the parent
  vConnection.Add(ASprig);
end;

{ TADOCommandSprig }

function TADOCommandSprig.AnyProblems: Boolean;
begin
  with TADOCommand(Item) do
    Result := ADOConAnyProblems(Connection, ConnectionString);
end;

function TADOCommandSprig.Caption: string;
var
  vPrefix: string;
begin
  with TADOCommand(Item) do
  begin
    vPrefix := cCommandTypes[CommandType];
    if CommandText <> '' then
      vPrefix := vPrefix + ' ' + CommandText;
    Result := CaptionFor(vPrefix, UniqueName);
  end;
end;

function TADOCommandSprig.DragDropTo(AItem: TSprig): Boolean;
var
  vConnection: TADOConnection;
  vConnectionString: WideString;
begin
  with TADOCommand(Item) do
  begin
    vConnection := Connection;
    vConnectionString := ConnectionString;
    Result := ADOConDropOver(AItem, vConnection, vConnectionString);
    if Result then
    begin
      Connection := vConnection;
      ConnectionString := vConnectionString;
    end;
  end;
end;

function TADOCommandSprig.DragOverTo(AItem: TSprig): Boolean;
begin
  Result := ADOConDragOver(AItem);
end;

procedure TADOCommandSprig.FigureParent;
begin
  ADOConFigureParent(Self, TADOCommand(Item).Connection,
                           TADOCommand(Item).ConnectionString);
end;

class function TADOCommandSprig.PaletteOverTo(AParent: TSprig;
  AClass: TClass): Boolean;
begin
  Result := ADOConDragOver(AParent);
end;

{ TCustomAdoDataSetSprig }

function TCustomADODataSetSprig.AnyProblems: Boolean;
begin
  with TCustomADODataSet(Item) do
    Result := (DataSetField = nil) and
              ADOConAnyProblems(Connection, ConnectionString);
end;

procedure TCustomADODataSetSprig.FigureParent;
begin
  with TCustomADODataSet(Item) do
    if DataSetField <> nil then
      SeekParent(DataSetField).Add(Self)
    else
      ADOConFigureParent(Self, Connection, ConnectionString);
end;

function TCustomADODataSetSprig.DragDropTo(AItem: TSprig): Boolean;
var
  vConnection: TADOConnection;
  vConnectionString: WideString;
begin
  with TCustomADODataSet(Item) do
    if AItem is TFieldSprig then
    begin
      Result := DataSetField <> AItem.Item;
      if Result then
        DataSetField := TDataSetField(AItem.Item);
      Connection := nil;
      ConnectionString := '';
    end
    else
    begin
      vConnection := Connection;
      vConnectionString := ConnectionString;
      Result := ADOConDropOver(AItem, vConnection, vConnectionString);
      if Result then
      begin
        Connection := vConnection;
        ConnectionString := vConnectionString;
      end;
      DataSetField := nil;
    end;
end;

function TCustomADODataSetSprig.DragOverTo(AItem: TSprig): Boolean;
begin
  Result := ((AItem is TFieldSprig) and
             (TFieldSprig(AItem).Item is TDataSetField)) or
            ADOConDragOver(AItem);
end;

class function TCustomADODataSetSprig.PaletteOverTo(AParent: TSprig;
  AClass: TClass): Boolean;
begin
  Result := ((AParent is TFieldSprig) and
             (TFieldSprig(AParent).Item is TDataSetField)) or
            ADOConDragOver(AParent);
end;

{ TADODataSetSprig }

function TADODataSetSprig.AnyProblems: Boolean;
begin
  Result := ((TADODataSet(Item).RDSConnection = nil) and
             inherited AnyProblems) or
            (TADODataSet(Item).CommandText = '');
end;

function TADODataSetSprig.Caption: string;
var
  vPrefix: string;
begin
  with TADODataSet(Item) do
  begin
    vPrefix := cCommandTypes[CommandType];
    if CommandText <> '' then
      vPrefix := vPrefix + ' ' + CommandText;
    Result := CaptionFor(vPrefix, UniqueName);
  end;
end;

function TADODataSetSprig.DragDropTo(AItem: TSprig): Boolean;
begin
  with TADODataSet(Item) do
    if AItem is TRDSConnectionSprig then
    begin
      Result := RDSConnection <> AItem.Item;
      if Result then
        RDSConnection := TRDSConnection(AItem.Item);
    end
    else
      Result := inherited DragDropTo(AItem);
end;

function TADODataSetSprig.DragOverTo(AItem: TSprig): Boolean;
begin
  Result := (AItem is TRDSConnectionSprig) or
            inherited DragOverTo(AItem);
end;

procedure TADODataSetSprig.FigureParent;
begin
  with TADODataSet(Item) do
    if RDSConnection <> nil then
      SeekParent(RDSConnection).Add(Self)
    else
      inherited;
end;

class function TADODataSetSprig.PaletteOverTo(AParent: TSprig;
  AClass: TClass): Boolean;
begin
  Result := (AParent is TRDSConnectionSprig) or
            inherited PaletteOverTo(AParent, AClass);
end;

{ TADOTableSprig }

function TADOTableSprig.AnyProblems: Boolean;
begin
  Result := TADOTable(Item).TableName = '';
end;

function TADOTableSprig.Caption: string;
begin
  Result := CaptionFor(TADOTable(Item).TableName, UniqueName);
end;

{ TADOStoredProcSprig }

function TADOStoredProcSprig.AnyProblems: Boolean;
begin
  Result := TADOStoredProc(Item).ProcedureName = '';
end;

function TADOStoredProcSprig.Caption: string;
begin
  Result := CaptionFor(TADOStoredProc(Item).ProcedureName, UniqueName);
end;

{ TADOQuerySprig }

function TADOQuerySprig.AnyProblems: Boolean;
begin
  Result := TADOQuery(Item).SQL.Text = '';
end;

{ TCustomADODataSetMasterDetailBridge }

class function TCustomADODataSetMasterDetailBridge.GetOmegaSource(
  AItem: TPersistent): TDataSource;
begin
  Result := TADODataSet(AItem).DataSource;
end;

class procedure TCustomADODataSetMasterDetailBridge.SetOmegaSource(
  AItem: TPersistent; ADataSource: TDataSource);
begin
  TADODataSet(AItem).DataSource := ADataSource;
end;

type
  TCustomADODataSetHack = class(TCustomADODataSet)
  end;

function TCustomADODataSetMasterDetailBridge.Caption: string;
begin
  Result := SNoMasterFields;
  if TCustomADODataSetHack(Omega.Item).CommandType = cmdText then
    Result := SParamsFields
  else if TCustomADODataSetHack(Omega.Item).MasterFields <> '' then
    Result := TCustomADODataSetHack(Omega.Item).MasterFields;
end;

{ TADODataSetMasterDetailBridge }

function TADODataSetMasterDetailBridge.CanEdit: Boolean;
begin
  Result := TADODataSet(Omega.Item).CommandType <> cmdText;
end;

function TADODataSetMasterDetailBridge.Edit: Boolean;
var
  vPropEd: TADODataSetFieldLinkProperty;
begin
  Result := False;
  if TADODataSet(Omega.Item).CommandType <> cmdText then
  begin
    vPropEd := TADODataSetFieldLinkProperty.CreateWith(TADODataSet(Omega.Item));
    try
      vPropEd.Edit;
      Result := vPropEd.Changed;
    finally
      vPropEd.Free;
    end;
  end;
end;

class function TADODataSetMasterDetailBridge.OmegaIslandClass: TIslandClass;
begin
  Result := TADODataSetIsland;
end;

{ TADOTableMasterDetailBridge }

function TADOTableMasterDetailBridge.CanEdit: Boolean;
begin
  Result := True;
end;

function TADOTableMasterDetailBridge.Edit: Boolean;
var
  vPropEd: TADOTableFieldLinkProperty;
begin
  vPropEd := TADOTableFieldLinkProperty.CreateWith(TADOTable(Omega.Item));
  try
    vPropEd.Edit;
    Result := vPropEd.Changed;
  finally
    vPropEd.Free;
  end;
end;

class function TADOTableMasterDetailBridge.OmegaIslandClass: TIslandClass;
begin
  Result := TADOTableIsland;
end;

{ TADOQueryMasterDetailBridge }

class function TADOQueryMasterDetailBridge.OmegaIslandClass: TIslandClass;
begin
  Result := TADOQueryIsland;
end;

{ TADOCommandIsland }

function TADOCommandIsland.VisibleTreeParent: Boolean;
begin
  Result := False;
end;

{ TCustomADODataSetIsland }

function TCustomADODataSetIsland.VisibleTreeParent: Boolean;
begin
  Result := False;
end;

procedure Register;
begin
  RegisterComponents(srADO, [TADOConnection, TADOCommand, TADODataSet,
    TADOTable, TADOQuery, TADOStoredProc, TRDSConnection]);
  RegisterPropertyEditor(TypeInfo(WideString), TADOConnection, 'Provider', TProviderProperty);
  RegisterPropertyEditor(TypeInfo(WideString), TADOConnection, 'ConnectionString', TConnectionStringProperty);
  RegisterPropertyEditor(TypeInfo(WideString), TADOCommand, 'ConnectionString', TConnectionStringProperty);
  RegisterPropertyEditor(TypeInfo(WideString), TCustomADODataSet, 'ConnectionString', TConnectionStringProperty);
  RegisterPropertyEditor(TypeInfo(WideString), TADODataSet, 'CommandText', TCommandTextProperty);
  RegisterPropertyEditor(TypeInfo(WideString), TADOCommand, 'CommandText', TCommandTextProperty);
  RegisterPropertyEditor(TypeInfo(WideString), TADOTable, 'TableName', TTableNameProperty);
  RegisterPropertyEditor(TypeInfo(WideString), TADOStoredProc, 'ProcedureName', TProcedureNameProperty);
  RegisterPropertyEditor(TypeInfo(TParameters), TCustomADODataSet, 'Parameters', TParametersProperty);
  RegisterPropertyEditor(TypeInfo(TParameters), TADOCommand, 'Parameters', TParametersProperty);
  RegisterPropertyEditor(TypeInfo(string), TCustomADODataSet, 'IndexName', TADOIndexNameProperty);
  RegisterComponentEditor(TADOConnection, TADOConnectionEditor);
  RegisterComponentEditor(TADOCommand, TADOCommandEditor);
  RegisterComponentEditor(TADODataSet, TADODataSetEditor);

  RegisterPropertyEditor(TypeInfo(string), TADODataSet, 'MasterFields', TADODataSetFieldLinkProperty);
  RegisterPropertyEditor(TypeInfo(string), TADOTable, 'MasterFields', TADOTableFieldLinkProperty);

  RegisterPropertiesInCategory(TDatabaseCategory, TADOConnection,
      ['Attributes','Command*','Connect*','DefaultDatabase','IsolationLevel',
       'LoginPrompt','Mode','Provider']);

  RegisterPropertiesInCategory(TDatabaseCategory, TADOCommand,
      ['Command*','Connect*','Cursor*','ExecuteOptions','Param*','Prepared']);

  RegisterPropertiesInCategory(TDatabaseCategory, TCustomADODataSet,
      ['CacheSize', 'ConnectionString', 'ExecuteOptions', 'MarshalOptions',
       'MaxRecords', 'Prepared', 'ProcedureName', 'Command*']);

  RegisterSprigType(TADOConnection, TADOConnectionSprig);
  RegisterSprigType(TRDSConnection, TRDSConnectionSprig);
  RegisterSprigType(TADOCommand, TADOCommandSprig);

  RegisterSprigType(TCustomADODataSet, TCustomADODataSetSprig);
  RegisterSprigType(TADODataSet, TADODataSetSprig);
  RegisterSprigType(TADOTable, TADOTableSprig);
  RegisterSprigType(TADOStoredProc, TADOStoredProcSprig);
  RegisterSprigType(TADOQuery, TADOQuerySprig);

  RegisterIslandType(TADOCommandSprig, TADOCommandIsland);
  RegisterIslandType(TCustomADODataSetSprig, TCustomADODataSetIsland);
  RegisterIslandType(TADODataSetSprig, TADODataSetIsland);
  RegisterIslandType(TADOTableSprig, TADOTableIsland);
  RegisterIslandType(TADOQuerySprig, TADOQueryIsland);

  RegisterBridgeType(TDataSetIsland, TADODataSetIsland, TADODataSetMasterDetailBridge);
  RegisterBridgeType(TDataSetIsland, TADOTableIsland, TADOTableMasterDetailBridge);
  RegisterBridgeType(TDataSetIsland, TADOQueryIsland, TADOQueryMasterDetailBridge);
end;

end.